home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / sgwnd10 / comboex.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-08-13  |  14.0 KB  |  370 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ComboEx 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H80000005&
  5.    CanGetFocus     =   0   'False
  6.    ClientHeight    =   372
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   2988
  10.    EditAtDesignTime=   -1  'True
  11.    ScaleHeight     =   31
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   249
  14.    ToolboxBitmap   =   "ComboEx.ctx":0000
  15. Attribute VB_Name = "ComboEx"
  16. Attribute VB_GlobalNameSpace = False
  17. Attribute VB_Creatable = True
  18. Attribute VB_PredeclaredId = False
  19. Attribute VB_Exposed = True
  20. Option Explicit
  21. Private cmb As ComboBoxEx
  22. Private mobjImageList As Object
  23. Private WithEvents mclsCombo As sgwindow.Window
  24. Attribute mclsCombo.VB_VarHelpID = -1
  25. Private WithEvents mclsComboEdit As sgwindow.Window
  26. Attribute mclsComboEdit.VB_VarHelpID = -1
  27. Private mlListIndex As Integer
  28. Private Const WM_KEYDOWN = &H100
  29. Private Const CBN_SELCHANGE = 1
  30. Private Const CBN_EDITCHANGE = 5
  31. Private Const CBN_EDITUPDATE = 6
  32. Private Const CBN_SELENDOK = 9
  33. 'Default Property Values:
  34. Const m_def_Text = ""
  35. Const m_def_Count = 0
  36. Const m_def_Style = 1
  37. Const m_def_BackColor = 0
  38. Const m_def_Enabled = 0
  39. Const m_def_FontBold = 0
  40. Const m_def_FontItalic = 0
  41. Const m_def_FontName = ""
  42. Const m_def_FontSize = 0
  43. Const m_def_ForeColor = 0
  44. Const m_def_MousePointer = 0
  45. Const m_def_OLEDropMode = 0
  46. 'Property Variables:
  47. Dim m_Style As Integer
  48. Dim m_BackColor As Long
  49. Dim m_Enabled As Boolean
  50. Dim m_Font As Font
  51. Dim m_FontBold As Boolean
  52. Dim m_FontItalic As Boolean
  53. Dim m_FontName As String
  54. Dim m_FontSize As Single
  55. Dim m_ForeColor As Long
  56. Dim m_MouseIcon As Picture
  57. Dim m_MousePointer As Integer
  58. Dim m_OLEDropMode As Integer
  59. 'events
  60. Public Event Change()
  61. Public Event Click()
  62. Public Event DblClick()
  63. Public Event KeyDown(KeyCode As Integer, Shift As Integer)
  64. Public Event KeyPress(KeyAscii As Integer)
  65. Public Event KeyUp(KeyCode As Integer, Shift As Integer)
  66. Public Event OLEDragOver(Data As DataObject, Effect As Integer, Button As Integer, Shift As Integer, X As Integer, Y As Integer, State As Integer)
  67. Public Event OLEDragDrop(Data As DataObject, Effect As Integer, Button As Integer, Shift As Integer, X As Integer, Y As Integer)
  68. Public Event OLEGiveFeedback(Effect As Integer, DefaultCursors As Integer)
  69. Public Event OLEStartDrag(Data As DataObject, AllowedEffects As Integer)
  70. Public Event OLESetData(Data As DataObject, DataFormat As Integer)
  71. Public Event OLECompleteDrag(Effect As Integer)
  72. Public Event Scroll()
  73. Private Declare Function CMB_SetFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
  74. Public Function AddItem(Text As String, Icon As Integer, _
  75.    Optional Indent As Integer = 0, _
  76.    Optional Index As Integer = -1) As ComboItem
  77.    cmb.Additems Text, Icon, Indent, Index
  78.    Set AddItem = cmb.ComboItems(cmb.ComboItems.Count)
  79. End Function
  80. Public Sub SetFocus()
  81.    If cmb.GetComboHwnd <> 0 Then CMB_SetFocus cmb.GetComboHwnd
  82. End Sub
  83. Private Sub mclsCombo_Message(ByVal msg As Long, _
  84.    ByVal wParam As Long, ByVal lParam As Long, _
  85.    ByRef result As Long)
  86.    On Error Resume Next
  87.    Select Case msg
  88.       Case wm_COMMAND
  89.          Select Case sgwindow.HighWord(wParam)
  90.             Case CBN_SELCHANGE
  91.                Select Case lParam
  92.                   Case cmb.GetComboHwnd
  93.                      mlListIndex = cmb.GetSelectedItem
  94.                      RaiseEvent Click
  95.                End Select
  96.             Case CBN_EDITCHANGE
  97.                RaiseEvent Change
  98.             Case CBN_SELENDOK
  99.                   mlListIndex = cmb.GetSelectedItem
  100.             Case Else
  101.                result = mclsCombo.CallWindowProc(msg, wParam, lParam)
  102.          End Select
  103.          
  104.       Case Else
  105.          result = mclsCombo.CallWindowProc(msg, wParam, lParam)
  106.    End Select
  107. End Sub
  108. Private Sub mclsComboEdit_Message(ByVal msg As Long, ByVal wParam As Long, _
  109.    ByVal lParam As Long, ByRef result As Long)
  110.    On Error Resume Next
  111.    Select Case msg
  112.       Case wm_LBUTTONDBLCLK
  113.          RaiseEvent DblClick
  114.       Case WM_KEYDOWN
  115.          RaiseEvent KeyDown(CInt(wParam), 0)
  116.       Case wm_KEYUP
  117.          RaiseEvent KeyUp(CInt(wParam), 0)
  118.       Case Else
  119.          result = mclsCombo.CallWindowProc(msg, wParam, lParam)
  120.    End Select
  121. End Sub
  122. Private Sub UserControl_EnterFocus()
  123.    If cmb.GetComboHwnd <> 0 Then CMB_SetFocus cmb.GetComboHwnd
  124. End Sub
  125. Private Sub UserControl_Initialize()
  126.    Dim clsControl As New sgwindow.Window
  127.    Dim lWinLong&
  128.    Set cmb = New ComboBoxEx
  129.    Set mclsCombo = New sgwindow.Window
  130.    mclsCombo.hwnd = UserControl.hwnd
  131.    mclsCombo.EnableMessage wm_COMMAND
  132.    mclsCombo.Hooked = True
  133.    If m_Style = 34 Then
  134.       Set mclsComboEdit = New Window
  135.       mclsComboEdit.hwnd = cmb.GetEdithWnd
  136.       mclsComboEdit.EnableMessage wm_LBUTTONDBLCLK
  137.       mclsComboEdit.EnableMessage WM_KEYDOWN
  138.       mclsComboEdit.Hooked = True
  139.    End If
  140. End Sub
  141. Private Sub UserControl_Resize()
  142.    On Error Resume Next
  143.    UserControl.Height = cmb.ResizeCombo(UserControl.Width)
  144. End Sub
  145. Private Sub UserControl_Terminate()
  146.    Set cmb = Nothing
  147.    Set mclsCombo = Nothing
  148. End Sub
  149. Public Property Get List(Index As Integer) As String
  150.    List = cmb.ComboItems.Item(Index + 1).Text
  151. End Property
  152. Public Property Let List(Index As Integer, ByVal vNewValue As String)
  153.    cmb.ComboItems.Item(Index + 1).Text = vNewValue
  154.    cmb.RefreshItem Index, vNewValue, _
  155.       cmb.ComboItems(Index + 1).Image, _
  156.       cmb.ComboItems(Index + 1).Indent
  157. End Property
  158. Public Property Get Text() As String
  159.    Text = cmb.GetEditString
  160. End Property
  161. Public Property Let ImageList(ByVal vNewValue As Object)
  162.    Set mobjImageList = vNewValue
  163.    cmb.ImageList = mobjImageList.HIMAGELIST
  164. End Property
  165. Public Property Get BackColor() As Long
  166. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  167.    BackColor = m_BackColor
  168. End Property
  169. Public Property Let BackColor(ByVal New_BackColor As Long)
  170.    m_BackColor = New_BackColor
  171.    PropertyChanged "BackColor"
  172. End Property
  173. Public Property Get Enabled() As Boolean
  174. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  175.    Enabled = m_Enabled
  176. End Property
  177. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  178.    m_Enabled = New_Enabled
  179.    PropertyChanged "Enabled"
  180. End Property
  181. Public Property Get Font() As Font
  182. Attribute Font.VB_Description = "Returns a Font object."
  183. Attribute Font.VB_UserMemId = -512
  184.    Set Font = m_Font
  185. End Property
  186. Public Property Set Font(ByVal New_Font As Font)
  187.    Set m_Font = New_Font
  188.    PropertyChanged "Font"
  189. End Property
  190. Public Property Get FontBold() As Boolean
  191. Attribute FontBold.VB_Description = "Returns/sets bold font styles."
  192.    FontBold = m_FontBold
  193. End Property
  194. Public Property Let FontBold(ByVal New_FontBold As Boolean)
  195.    m_FontBold = New_FontBold
  196.    PropertyChanged "FontBold"
  197. End Property
  198. Public Property Get FontItalic() As Boolean
  199. Attribute FontItalic.VB_Description = "Returns/sets italic font styles."
  200.    FontItalic = m_FontItalic
  201. End Property
  202. Public Property Let FontItalic(ByVal New_FontItalic As Boolean)
  203.    m_FontItalic = New_FontItalic
  204.    PropertyChanged "FontItalic"
  205. End Property
  206. Public Property Get FontName() As String
  207. Attribute FontName.VB_Description = "Specifies the name of the font that appears in each row for the given level."
  208.    FontName = m_FontName
  209. End Property
  210. Public Property Let FontName(ByVal New_FontName As String)
  211.    m_FontName = New_FontName
  212.    PropertyChanged "FontName"
  213. End Property
  214. Public Property Get FontSize() As Single
  215. Attribute FontSize.VB_Description = "Specifies the size (in points) of the font that appears in each row for the given level."
  216.    FontSize = m_FontSize
  217. End Property
  218. Public Property Let FontSize(ByVal New_FontSize As Single)
  219.    m_FontSize = New_FontSize
  220.    PropertyChanged "FontSize"
  221. End Property
  222. Public Property Get ForeColor() As Long
  223. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  224.    ForeColor = m_ForeColor
  225. End Property
  226. Public Property Let ForeColor(ByVal New_ForeColor As Long)
  227.    m_ForeColor = New_ForeColor
  228.    PropertyChanged "ForeColor"
  229. End Property
  230. Public Property Get MouseIcon() As Picture
  231. Attribute MouseIcon.VB_Description = "Sets a custom mouse icon."
  232.    Set MouseIcon = m_MouseIcon
  233. End Property
  234. Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)
  235.    Set m_MouseIcon = New_MouseIcon
  236.    PropertyChanged "MouseIcon"
  237. End Property
  238. Public Property Get MousePointer() As Integer
  239. Attribute MousePointer.VB_Description = "Returns/sets the type of mouse pointer displayed when over part of an object."
  240.    MousePointer = m_MousePointer
  241. End Property
  242. Public Property Let MousePointer(ByVal New_MousePointer As Integer)
  243.    m_MousePointer = New_MousePointer
  244.    PropertyChanged "MousePointer"
  245. End Property
  246. Public Sub OLEDrag()
  247. Attribute OLEDrag.VB_Description = "Starts an OLE drag/drop event with the given control as the source."
  248. End Sub
  249. Public Property Get OLEDropMode() As Integer
  250. Attribute OLEDropMode.VB_Description = "Returns/Sets whether this object can act as an OLE drop target."
  251.    OLEDropMode = m_OLEDropMode
  252. End Property
  253. Public Property Let OLEDropMode(ByVal New_OLEDropMode As Integer)
  254.    m_OLEDropMode = New_OLEDropMode
  255.    PropertyChanged "OLEDropMode"
  256. End Property
  257. Public Property Get ImageList() As Object
  258.    Set ImageList = mobjImageList
  259. End Property
  260. Public Function Clear() As Variant
  261.    cmb.Clear
  262. End Function
  263. Public Sub Remove(Index As Integer)
  264.    cmb.RemoveItem Index
  265. End Sub
  266. 'Initialize Properties for User Control
  267. Private Sub UserControl_InitProperties()
  268.    m_BackColor = m_def_BackColor
  269.    m_Enabled = m_def_Enabled
  270.    Set m_Font = Ambient.Font
  271.    m_FontBold = m_def_FontBold
  272.    m_FontItalic = m_def_FontItalic
  273.    m_FontName = m_def_FontName
  274.    m_FontSize = m_def_FontSize
  275.    m_ForeColor = m_def_ForeColor
  276.    Set m_MouseIcon = LoadPicture("")
  277.    m_MousePointer = m_def_MousePointer
  278.    m_OLEDropMode = m_def_OLEDropMode
  279.    m_Style = m_def_Style
  280. End Sub
  281. 'Load property values from storage
  282. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  283.    m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
  284.    m_Enabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
  285.    Set m_Font = PropBag.ReadProperty("Font", Ambient.Font)
  286.    m_FontBold = PropBag.ReadProperty("FontBold", m_def_FontBold)
  287.    m_FontItalic = PropBag.ReadProperty("FontItalic", m_def_FontItalic)
  288.    m_FontName = PropBag.ReadProperty("FontName", m_def_FontName)
  289.    m_FontSize = PropBag.ReadProperty("FontSize", m_def_FontSize)
  290.    m_ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
  291.    Set m_MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
  292.    m_MousePointer = PropBag.ReadProperty("MousePointer", m_def_MousePointer)
  293.    m_OLEDropMode = PropBag.ReadProperty("OLEDropMode", m_def_OLEDropMode)
  294.    m_Style = PropBag.ReadProperty("Style", m_def_Style)
  295.    With cmb
  296.       .ParentHwnd = UserControl.hwnd
  297.       .Create m_Style
  298.    End With
  299.    UserControl_Resize
  300. End Sub
  301. 'Write property values to storage
  302. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  303.    Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
  304.    Call PropBag.WriteProperty("Enabled", m_Enabled, m_def_Enabled)
  305.    Call PropBag.WriteProperty("Font", m_Font, Ambient.Font)
  306.    Call PropBag.WriteProperty("FontBold", m_FontBold, m_def_FontBold)
  307.    Call PropBag.WriteProperty("FontItalic", m_FontItalic, m_def_FontItalic)
  308.    Call PropBag.WriteProperty("FontName", m_FontName, m_def_FontName)
  309.    Call PropBag.WriteProperty("FontSize", m_FontSize, m_def_FontSize)
  310.    Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
  311.    Call PropBag.WriteProperty("MouseIcon", m_MouseIcon, Nothing)
  312.    Call PropBag.WriteProperty("MousePointer", m_MousePointer, m_def_MousePointer)
  313.    Call PropBag.WriteProperty("OLEDropMode", m_OLEDropMode, m_def_OLEDropMode)
  314.    Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
  315. End Sub
  316. Public Property Get hwnd() As Long
  317. Attribute hwnd.VB_Description = "Returns a handle (from Microsoft Windows) to an object's window."
  318. Attribute hwnd.VB_MemberFlags = "400"
  319.    hwnd = cmb.GetComboHwnd
  320. End Property
  321. Public Property Get ItemData(Index As Integer) As Long
  322. Attribute ItemData.VB_MemberFlags = "400"
  323.    ItemData = cmb.ComboItems(Index + 1).ItemData
  324. End Property
  325. Public Property Let ItemData(Index As Integer, ByVal New_ItemData As Long)
  326.       cmb.ComboItems(Index + 1).ItemData = New_ItemData
  327. End Property
  328. Public Property Get NewIndex() As Integer
  329. Attribute NewIndex.VB_MemberFlags = "400"
  330.    NewIndex = cmb.NewIndex
  331. End Property
  332. Public Property Get ListIndex() As Integer
  333. Attribute ListIndex.VB_MemberFlags = "400"
  334.    ListIndex = mlListIndex
  335. End Property
  336. Public Property Let ListIndex(ByVal New_ListIndex As Integer)
  337.    mlListIndex = New_ListIndex
  338.    cmb.SetIndex mlListIndex
  339.    RaiseEvent Click
  340. End Property
  341. Public Property Get ComboItem(Index As Integer) As ComboItem
  342. Attribute ComboItem.VB_MemberFlags = "400"
  343.    Set ComboItem = cmb.ComboItems.Item(Index + 1)
  344. End Property
  345. Public Property Set ComboItem(Index As Integer, ByVal New_Item As ComboItem)
  346.    Set cmb.ComboItems.Item(Index + 1) = New_Item
  347. End Property
  348. Public Property Get ListCount() As Integer
  349. Attribute ListCount.VB_MemberFlags = "400"
  350.    ListCount = cmb.ComboItems.Count
  351. End Property
  352. Public Property Get Style() As Integer
  353.    Style = m_Style
  354. End Property
  355. Public Property Let Style(ByVal New_Style As Integer)
  356.    If Ambient.UserMode Then Err.Raise 393
  357.    If New_Style < 0 Or New_Style > 3 Then Exit Property
  358.    If m_Style <> New_Style Then
  359.       m_Style = New_Style
  360.       
  361.       'On Error Resume Next
  362.       
  363.       PropertyChanged "Style"
  364.       cmb.Destroy
  365.       
  366.       cmb.Create m_Style
  367.       UserControl_Resize
  368.    End If
  369. End Property
  370.